home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 2003 August / MW 8 2003 CD1.iso / Inside Macworld / Product News / gimp-1.2.4.sit / gimp-1.2.4 / plug-ins / perl / examples / visual < prev    next >
Encoding:
Text File  |  2000-08-24  |  7.6 KB  |  328 lines
  1. #!/usr/bin/perl
  2.  
  3. # this is just a very basic hack...
  4.  
  5. use Gimp::Feature qw(perl-5.005 gtk-1.2);
  6. use Gimp (':consts','__','N_');
  7. use Gimp::Fu;
  8. use Gnome;
  9. #use Gtk 0.61231;
  10. use Gtk;
  11. use Gtk::Gdk;
  12. use Gimp::UI (); # for the logo
  13.  
  14. $VERSION = 0.0;
  15.  
  16. $tabw = 30;
  17. $tabh = 12;
  18.  
  19. #Gimp::set_trace(TRACE_ALL);
  20.  
  21. @stringtargets = (
  22.     { target => "STRING",     flags => 0, info => TARGET_STRING },
  23.     { target => "text/plain", flags => 0, info => TARGET_STRING },
  24. );
  25.  
  26. @funcframetarget = (
  27.     { target => "application/funcframe", flags => 0, info => TARGET_STRING },
  28. );
  29.  
  30. %typetargets = (
  31.   &PF_IMAGE  => [{ target => "application/image-link", flags => 0, info => 0 }],
  32.   &PF_INT32  => [{ target => "application/value-link", flags => 0, info => 0 }],
  33.   &PF_STRING => [{ target => "application/value-link", flags => 0, info => 0 }],
  34. );
  35.  
  36. my $ex;        # average font width for default font
  37. my $ey;        # average font height for default font
  38.  
  39. my $window;    # the main window
  40. my $canvas;    # the gtklayout widget
  41. my $funclist;
  42.  
  43. my %type2str = (
  44.    &PDB_BOUNDARY    => 'BOUNDARY',
  45.    &PDB_CHANNEL     => 'CHANNEL',
  46.    &PDB_COLOR       => 'COLOR',
  47.    &PDB_DISPLAY     => 'DISPLAY',
  48.    &PDB_DRAWABLE    => 'DRAWABLE',
  49.    &PDB_FLOAT       => 'FLOAT',
  50.    &PDB_IMAGE       => 'IMAGE',
  51.    &PDB_INT32       => 'INT32',
  52.    &PDB_FLOATARRAY  => 'FLOATARRAY',
  53.    &PDB_INT16       => 'INT16',
  54.    &PDB_PARASITE    => 'PARASITE',
  55.    &PDB_STRING      => 'STRING',
  56.    &PDB_PATH        => 'PATH',
  57.    &PDB_INT16ARRAY  => 'INT16ARRAY',
  58.    &PDB_INT8        => 'INT8',
  59.    &PDB_INT8ARRAY   => 'INT8ARRAY',
  60.    &PDB_LAYER       => 'LAYER',
  61.    &PDB_REGION      => 'REGION',
  62.    &PDB_STRINGARRAY => 'STRINGARRAY',
  63.    &PDB_SELECTION   => 'SELECTION',
  64.    &PDB_STATUS      => 'STATUS',
  65.    &PDB_INT32ARRAY  => 'INT32ARRAY',
  66. );
  67.  
  68. sub add_func($$;) {
  69.    my($group,$func)=@_;
  70.    $funclist->append($func);
  71. }
  72.  
  73. sub create_main {
  74.    my $t = new Gtk::Tooltips;
  75.    my $w = new Gtk::Window;
  76.  
  77.    my $v = new Gtk::VBox 0,5;
  78.    my $h = new Gtk::HBox 0,5;
  79.  
  80.    $canvas = new ProgShell;
  81.  
  82.    $funclist = new Gtk::CList 1;
  83.    $funclist->set_usize(200,0);
  84.    $funclist->drag_source_set ([-button1_mask, -button3_mask], [-copy, -move], @::stringtargets);
  85.  
  86.    $funclist->signal_connect ("drag_data_get", sub {
  87.       my ($widget, $context, $data, $info, $time) = @_;
  88.       $data->set ($data->target, 8, $widget->get_text($widget->selection,0));
  89.    });
  90.  
  91.    $funclist->set_selection_mode(-extended);
  92.  
  93.    $w->add ($h);
  94.    $h->add ($v);
  95.  
  96.    my $sc = new Gtk::ScrolledWindow;
  97.    $sc->add ($funclist);
  98.    $v->add ($sc);
  99.    $h->add ($canvas);
  100.  
  101.    for (sort Gimp->procedural_db_query("","","","","","","")) {
  102.       $group = "gimp";
  103.       $group = "image"    if /^gimp_image_/;
  104.       $group = "layer"    if /^gimp_layer_/;
  105.       $group = "channel"  if /^gimp_channel_/;
  106.       $group = "drawable" if /^gimp_drawable_/;
  107.       add_func $group, $_;
  108.       $gimpfunc{$_} = 1;
  109.    }
  110.    $window = $w;
  111.    $w->realize;
  112.    $ex = $w->style->font->string_width ('Mn')*0.5;
  113.    $ey = $w->style->font->string_width ('My');
  114.  
  115.    $w->set_title(__"Visual Scriptor");
  116.    $w->signal_connect("destroy",sub {main_quit Gtk});
  117.  
  118.    show_all $w;
  119. }
  120.  
  121. register "extension_visual_scriptor",
  122.          "Visual Gimp Scripting Environment",
  123.          "=pod(DESCRIPTION)",
  124.          "Marc Lehmann",
  125.          "Marc Lehmann",
  126.          $VERSION,
  127.          N_"<Toolbox>/Xtns/Visual Scriptor...",
  128.          "",
  129.          [],
  130.          sub {
  131.  
  132.    Gimp::gtk_init;
  133.  
  134.    create_main;
  135.    main Gtk;
  136.  
  137.    ();
  138. };
  139.  
  140. # the basic function/node-type
  141. package Func;
  142.  
  143. use Gimp;
  144.  
  145. sub new_from_gimp_func {
  146.    my $name = shift;
  147.    my $self = {};
  148.    my ($narg, $nval);
  149.    (
  150.       $self->{blurb},
  151.       $self->{help},
  152.       $self->{author},
  153.       $self->{copyright},
  154.       $self->{date},
  155.       $self->{proc_type},
  156.       $narg,
  157.       $nval,
  158.    ) = Gimp->procedural_db_proc_info($name);
  159.    $self->{in } = [map Gimp->procedural_db_proc_arg($name,$_), 0..$narg-1];
  160.    $self->{out} = [map Gimp->procedural_db_proc_val($name,$_), 0..$nval-1];
  161.    $self;
  162. }
  163.  
  164. sub new_from_name {
  165.    my $class = shift;
  166.    my $name = shift;
  167.    $new{$name} = new_from_gimp_func($name) if !$new{$name} && $::gimpfunc{$name};
  168.    $new{$name} ?
  169.       bless {
  170.          name => $name,
  171.          %{$new{$name}},
  172.       }, $class
  173.    :
  174.       ();
  175. }
  176.  
  177. # a connection tab
  178. package Tab;
  179.  
  180. use Gimp::basewidget Gtk::Button;
  181.  
  182. sub OPEN (){1}
  183. sub CONN (){2}
  184. sub BOUND(){3}
  185.  
  186. sub GTK_CLASS_INIT {
  187.    my $class = shift;
  188.    add_arg_type $class "state", "gint", 3, 1;
  189.    add_arg_type $class "type" , "gint", 3, 2;
  190.    add_arg_type $class "dir"  , "gint", 3, 3;
  191. }
  192.  
  193. sub GTK_OBJECT_SET_ARG {
  194.    my($self,$arg,$id,$value) = @_;
  195.    print "SA $self,$arg,$id,$value\n";
  196.    if ($id == 1) {
  197.       $self->{state} = $value;
  198.    } elsif ($id == 2) {
  199.       $self->{type}  = $value;
  200.       $self->drag_dest_set('all', ['copy'], $::typetargets{$value});
  201.       $self->drag_source_set ([-button1_mask], [-copy], $::typetargets{$value});
  202.    } elsif ($id == 3) {
  203.       $self->{dir}   = $value;
  204.    }
  205. }
  206.  
  207. sub GTK_OBJECT_GET_ARG {
  208.    my($self,$arg,$id) = @_;
  209.    if ($id == 1) {
  210.       $self->{state};
  211.    } elsif ($id == 2) {
  212.       $self->{type};
  213.    } elsif ($id == 3) {
  214.       $self->{dir};
  215.    }
  216. }
  217.  
  218. sub GTK_OBJECT_INIT {
  219.    shift unless ref $self; # care for "old" Gtk modules
  220.    $self->set_usize($::tabw, $::tabh);
  221. }
  222.  
  223. sub new {
  224.    my $class = shift;
  225.    $class->SUPER::new(@_);
  226.    #$class->SUPER::new(shadow => out, @_);
  227. }
  228.  
  229. # a single function or "block", can only exist
  230. # within a progshell
  231. package FuncFrame;
  232.  
  233. use Gimp::basewidget Gtk::VBox;
  234.  
  235. sub GTK_OBJECT_INIT {
  236.    my $self = shift;
  237.    
  238.    signal_connect $self draw => sub {
  239.       print "re-drawing @_\n\n";
  240.    };
  241.    signal_connect $self realize => sub {
  242.       print "realize @_\n\n";
  243.    };
  244.  
  245.    $self->add ($self->{inbox } = new Gtk::HBox 1, $::tabw*0.6);
  246.    $self->add ($self->{button} = new Gtk::Button);
  247.    $self->add ($self->{outbox} = new Gtk::HBox 1, $::tabw*0.6);
  248.     
  249.    $self->{button}->add(
  250.       $self->{label} = new Gtk::Label
  251.    );
  252. }
  253.  
  254. sub set_func {
  255.    my($self,$func)=@_;
  256.    $self->{func} = $func;
  257.    $self->{inbox }->remove($_) for $self->{inbox }->children;
  258.    $self->{outbox}->remove($_) for $self->{outbox}->children;
  259.    my $w = 1;
  260.    my $in  = $self->{func}->{in };
  261.    my $out = $self->{func}->{out};
  262.    for (@$in) {
  263.       $self->{inbox }->add (new Tab type => $_->[0], dir => 0);
  264.    }
  265.    for (@$out) {
  266.       $self->{outbox}->add (new Tab type => $_->[0], dir => 1);
  267.    }
  268.    $self->{label}->set($func->{name});
  269. }
  270.  
  271. sub new_from_name {
  272.    my $class = shift;
  273.    my $func = Func->new_from_name (shift);
  274.    if ($func) {
  275.       my $self = $class->new(@_);
  276.       $self->set_func($func);
  277.       $self;
  278.    } else {
  279.       ();
  280.    }
  281. }
  282.  
  283. # the shell canvas
  284. package ProgShell;
  285.  
  286. use Gimp::basewidget Gtk::Layout;
  287.  
  288. sub new {
  289.    print "new for progshell ",ProgShell->_object_type,"\n";
  290.    Gtk::Object::new("ProgShell");
  291. }
  292.  
  293. sub GTK_CLASS_INIT { }
  294. sub GTK_OBJECT_INIT {
  295.    my $canvas = shift;
  296.    print "X @_\n";
  297.  
  298.    $canvas->set_usize (600, 800);
  299.    $canvas->set_hadjustment(0);
  300.    $canvas->set_vadjustment(0);
  301.    $canvas->set_app_paintable(1);
  302.  
  303.    $canvas->signal_connect (draw => sub {
  304.          print "DRAW @_ : ",@{$_[1]},"\n";
  305.    });
  306.  
  307.    $canvas->signal_connect (drag_data_received => sub {
  308.       my ($widget, $context, $x, $y, $data, $info, $time) = @_;
  309.       my $type = Gtk::Gdk::Atom->name($data->type);
  310.       if (($type eq "STRING" || $type eq "text/plain") && $data->format == 8) {
  311.          my $widget = FuncFrame->new_from_name($data->data);
  312.          $widget->show_all;
  313.          $canvas ->put($widget,$x,$y);
  314.          #printf ("Received \"%s\" in trashcan at $x, $y\n", $data->data);
  315.       } else {
  316.          $context->finish (0, 0, $time);
  317.       }
  318.       $context->finish (1, 0, $time);
  319.    });
  320.  
  321.    $canvas->drag_dest_set('all', ['copy'], @::stringtargets);
  322. }
  323.  
  324. package main;
  325.  
  326. exit main;
  327.  
  328.